home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / arexx / ole1v10a.lha / OLE_System / modules / fw3 / DrawTable.fw < prev    next >
Encoding:
Text File  |  1995-02-10  |  11.3 KB  |  592 lines
  1. /*
  2.  * DrawTable.fw
  3.  *
  4.  * USAGE: DrawTable.fw(ArgObject)
  5.  *
  6.  * The second module of my OLE system. This take the description of a
  7.  * table placed in the ClipList and draw a table into FinalWriter. The
  8.  * second important function implemented is to write all those information
  9.  * necessary to update the imported table later.
  10.  *
  11.  * TODO: columns at the same size
  12.  *
  13.  * HISTORY:
  14.  * v1.01    Drop the PIPE: before quit
  15.  *
  16.  * v1.02    added the progress indicator
  17.  *
  18.  * v1.03    added ActivateGadget()
  19.  *
  20.  * v1.04    aligned with the new server design v1.10
  21.  *
  22.  * v1.05    Bug fixed to use with FinalWriter Release 3
  23.  *
  24.  * $(C): (1994, Rocco Coluccelli, Bologna)
  25.  * $VER: DrawTable.fw 1.05 (03.Feb.1995)
  26.  */
  27.  
  28. OPTIONS RESULTS
  29.  
  30. /*
  31.  *    Read the startup clip
  32.  *    start point for gadgets, font dimension, commands ports, ...
  33.  */
  34. PARSE ARG oleclip
  35. PARSE VALUE GETCLIP(oleclip) WITH jobID modID box.left box.top char.w char.h olewin oleport olehost . userport olepipe locale config .
  36.  
  37.     fwobold.    = 100
  38.     fwoitalic.  = 0
  39.  
  40. IF ~SHOW('C',config) THEN DO
  41.     rowgap = 15; colgap = 35; measure = 2
  42.     fwobold.1   = 130
  43.     fwoitalic.1 = 2
  44.     pref.box  = 1; pref.line = 1; pref.link = 0
  45.     END
  46.  
  47. ELSE PARSE VALUE GETCLIP(config) WITH rowgap','colgap','measure','fwobold.1','fwoitalic.1','pref.box','pref.line','pref.link','
  48.  
  49.     ms.1 = 1;            ms.type.1 = GetLocale(1)
  50.     ms.2 = 2.54 / 720;    ms.type.2 = GetLocale(2)
  51.     ms.3 = 1 / 720;        ms.type.3 = GetLocale(3)
  52.  
  53. ADDRESS VALUE oleport
  54.  
  55. IF OPENPORT(olehost) == NULL() THEN DO
  56.     ERROR jobID modID 1 olehost
  57.     SETJOB jobID 'end'
  58.     EXIT 10
  59.     END
  60.  
  61. st = GUIGads()
  62. DO UNTIL st = 'end'
  63.  
  64.     CALL WAITPKT(olehost)
  65.     pkt = GETPKT(olehost)
  66.  
  67.     IF pkt == NULL() THEN ITERATE
  68.  
  69.     PARSE VALUE GETARG(pkt) WITH cmd argv
  70.     PARSE VALUE GETARG(pkt,1) WITH n0 nn .
  71.  
  72.     SELECT
  73.  
  74.         WHEN cmd = 'GAP' THEN DO
  75.             gap = GETARG(pkt,2)
  76.  
  77.             IF gap < 0 THEN gap = 0
  78.             gap = gap % ms.measure
  79.  
  80.             IF argv = 'COLS' THEN
  81.                 colgap = gap
  82.             ELSE
  83.                 rowgap = gap
  84.  
  85.             g_str.n0 = gap * ms.measure
  86.         END
  87.  
  88.         WHEN cmd = 'PREFS' THEN DO
  89.             PARSE VAR argv cmd .
  90.  
  91.             pref.cmd = ~pref.cmd
  92.             g_str.n0 = pref.cmd
  93.         END
  94.  
  95.         WHEN cmd = 'MEASURE' THEN DO
  96.             PARSE VALUE GETARG(pkt,2) WITH n1 n2 .
  97.  
  98.             measure = measure + 1; IF measure > 3 THEN measure = 1
  99.  
  100.             g_str.n0 = ms.type.measure
  101.             g_str.n1 = colgap * ms.measure; g_str.n2 = rowgap * ms.measure
  102.             CALL Gadgets(2,n1,n2)
  103.         END
  104.  
  105.         WHEN cmd = 'UNICONIFY' THEN
  106.             CALL Gadgets(8,1,g_gads)
  107.  
  108.         WHEN cmd = 'HELP' THEN
  109.             ABOUT jobID modID 'HELP' || st
  110.  
  111.         WHEN cmd = 'START' | cmd = 'QUIT' THEN
  112.             st = 'end'
  113.  
  114.         OTHERWISE NOP
  115.  
  116.     END
  117.  
  118.     IF n0 ~= '' THEN DO
  119.         CALL Gadgets(2,n0)
  120.         IF nn ~= '' THEN CALL ActivateGadget(olewin,GAD.nn)
  121.         CALL SETCLIP(config,rowgap','colgap','measure','fwobold.1','fwoitalic.1','pref.box','pref.line','pref.link',')
  122.         END
  123.  
  124.     CALL REPLY(pkt,0)
  125.  
  126. END
  127.  
  128. CALL CLOSEPORT(olehost)
  129.  
  130. IF ~OPEN(pip,'PIPE:' || olepipe,'R') THEN DO
  131.     SETJOB jobID 'end'
  132.     EXIT 0
  133.     END
  134.  
  135. /*
  136.  *    Drop the PIPE: if we are going to quit
  137.  */
  138. IF cmd = 'QUIT' THEN DO
  139.     DO UNTIL EOF(pip)
  140.         CALL READCH(pip,20000)
  141.     END
  142.     EXIT 0
  143.     END
  144.  
  145. COMPLETE jobID modID 1
  146.  
  147. /*
  148.  * redirect commands to FinalWriter
  149.  */
  150. ADDRESS VALUE userport
  151.  
  152. SetMeasure 'MICROPOINTS'
  153. View 50
  154.  
  155. /*
  156.  * Get the actual page number and the font path
  157.  */
  158. Status 'Page'
  159. page = result
  160. Status 'FontPath'
  161. fontpath = LEFT(result,LASTPOS('/',result))
  162.  
  163. /*
  164.  * Get the max dimension for the table
  165.  */
  166. GetPageSetup 'Width' 'Height' 'Top' 'Bottom' 'Left' 'Right'
  167. PARSE VAR result maxwidth maxheight top bottom left right .
  168.  
  169. maxwidth  = (maxwidth - left - right)
  170. maxheight = (maxheight - top - bottom)
  171.  
  172. /*
  173.  * Get the user preferences over lines and boxes
  174.  * Draw a box around the table
  175.  */
  176. IF pref.line THEN LinePrefs 'PROMPT'
  177. IF pref.box  THEN BoxPrefs  'PROMPT'
  178.  
  179. DrawBox page left top maxwidth maxheight
  180. line.0 = result
  181.  
  182. /*
  183.  * get spreadname and ranges
  184.  *
  185.  * TODO: write these information into the linkfile
  186.  */
  187. spreadname = READLN(pip)
  188. ranges = READLN(pip)
  189.  
  190. /*
  191.  * Table of font equivalents
  192.  */
  193. fwofont.        = fontpath || 'SoftSans'
  194. fwofont.SYMBOL  = fontpath || 'Symbol'
  195. fwofont.COURIER = fontpath || 'Courier'
  196. fwofont.TIMES   = fontpath || 'SoftSerif'
  197.  
  198. bold.    = ''
  199. bold.1   = 'Bold'
  200. italic.  = ''
  201. italic.1 = 'Italic'
  202.  
  203. palette. = 'Black'
  204.  
  205. colborder. = 0
  206. rowborder. = 0
  207. height.    = 0
  208. width.    = 0
  209. cell. = 0
  210.  
  211. PARSE VALUE READLN(pip) WITH rows cols .
  212.  
  213. /*
  214.  * Read data from the clip, draw all cell excluding empty cells.
  215.  * Find the dimension of each row and column and calculate how
  216.  * large will be the table to fit page.
  217.  *
  218.  * HEADER:
  219.  * spreadfile
  220.  * ranges
  221.  * rows cols
  222.  *
  223.  * DATAS:
  224.  * row col align bold italic underline color len 'þ'text'Þ' 'þ'font'Þ' size lleft lright lup ldown
  225.  *
  226.  * (row col) of the cell, (len) length in chars of (text)
  227.  * (align) aligned with (bold italic underline) style
  228.  * typed in (color) with (font) of (size)
  229.  * with borders (lineleft lineright lineup linedown)
  230.  */
  231. CALL Complete(5)
  232. DO FOREVER
  233.  
  234.     PARSE VALUE READLN(pip) WITH i j align.i.j bo it under.i.j . . 'þ'text'Þ' 'þ'font'Þ' size lleft lright lup ldown .
  235.  
  236.     IF i = '' THEN LEAVE
  237.  
  238.     fwofont = fwofont.font
  239.     font = fwofont || '_' || bold.bo || italic.it
  240.  
  241.     IF EXISTS(font) THEN
  242.         TextBlockTypePrefs "Size" size "Color" palette.0 "Font" font
  243.     ELSE
  244.         TextBlockTypePrefs "Size" size "Width" fwobold.bo "Oblique" fwoitalic.it "Color" palette.0 "Font" fwofont
  245.  
  246.     DrawTextBlock page left top '"'text'"'
  247.     cell.i.j = result
  248.  
  249.     IF lleft THEN colborder.i.j = 1
  250.     IF lup THEN rowborder.i.j = 1
  251.     IF lright THEN INTERPRET 'colborder.'i'.'j + 1' = 1'
  252.     IF ldown THEN INTERPRET 'rowborder.'i + 1'.'j' = 1'
  253. END
  254.  
  255. CALL CLOSE(pip)
  256. CALL Complete(15)
  257.  
  258. /*
  259.  *    This fix the bug in the Release 3
  260.  */
  261. Redraw
  262.  
  263. DO j = 1 to cols
  264.     DO i = 1 TO rows
  265.  
  266.         IF cell.i.j ~= 0 THEN DO
  267.             GetObjectCoords cell.i.j
  268.             PARSE VAR result . . . width.i.j height.i.j .
  269.             height.i = MAX(height.i,height.i.j)
  270.             width.j  = MAX(width.j,width.i.j)
  271.         END
  272.  
  273.     END
  274. END
  275. CALL Complete(20)
  276.  
  277. /*
  278.  * calculate the position of rows and columns
  279.  * centering the table in the current page
  280.  */
  281. col.1 = left
  282. DO j = 2 TO cols + 1
  283.     i = j - 1
  284.     col.j = col.i + width.i + 2 * colgap
  285. END
  286.  
  287. row.1 = top
  288. DO i = 2 TO rows + 1
  289.     j = i - 1
  290.     row.i = row.j + height.j + 2 * rowgap
  291. END
  292.  
  293.  
  294. /*
  295.  * move each cell to its correct position
  296.  *
  297.  * fix vertical and horizontal alignement
  298.  * draw the "underline"
  299.  */
  300. n = 0
  301. DO i = 1 TO rows
  302.  
  303.     top = row.i + TRUNC(height.i * 0.72)
  304.     und = top + rowgap
  305.     DO j = 1 TO cols WHILE cell.i.j ~= 0
  306.  
  307.         SELECT
  308.             WHEN align.i.j = '010' THEN
  309.                 left = col.j + width.j - width.i.j
  310.             WHEN align.i.j = '001' THEN
  311.                 left = col.j + (width.j - width.i.j) % 2
  312.  
  313.             OTHERWISE left = col.j
  314.         END
  315.  
  316.         SetObjectCoords cell.i.j page left top width.i.j height.i.j
  317.  
  318.         IF under.i.j THEN DO
  319.             n = n + 1
  320.             DrawLine page left und (left + width.i.j) und
  321.             line.n = result
  322.         END
  323.     END
  324. END
  325. CALL Complete(50)
  326.  
  327. Redraw
  328.  
  329.  
  330. /*
  331.  * calculate table's dimension to redraw the box
  332.  */
  333. boxwidth = col.j - col.1
  334. boxheight = row.i - row.1
  335.  
  336. top = row.1 - rowgap
  337. bottom = row.i - rowgap
  338. left = col.1 - colgap
  339. right  = col.j - colgap
  340.  
  341. SetObjectCoords line.0 page left top boxwidth boxheight
  342.  
  343. /*
  344.  * draw borders around cells
  345.  */
  346. DO j = 1 TO cols + 1
  347.  
  348.     left = col.j - colgap
  349.     DO i = 1 TO rows + 1
  350.  
  351.         DO WHILE ~colborder.i.j
  352.             IF i > rows THEN ITERATE j
  353.             i = i + 1
  354.             END
  355.  
  356.         top = row.i - rowgap
  357.         DO WHILE colborder.i.j & i <= rows
  358.             i = i + 1
  359.             END
  360.  
  361.         n = n + 1
  362.         DrawLine page left top left (row.i - rowgap)
  363.         line.n = result
  364.     END
  365.  
  366. END
  367. CALL Complete(65)
  368.  
  369. DO i = 1 TO rows + 1
  370.  
  371.     top = row.i - rowgap
  372.     DO j = 1 TO cols + 1
  373.  
  374.         DO WHILE ~rowborder.i.j
  375.             IF j > cols THEN ITERATE i
  376.             j = j + 1
  377.             END
  378.  
  379.         left = col.j - colgap
  380.         DO WHILE rowborder.i.j & j <= cols
  381.             j = j + 1
  382.             END
  383.  
  384.         n = n + 1
  385.         DrawLine page left top (col.j - colgap) top
  386.         line.n = result
  387.     END
  388.  
  389. END
  390. CALL Complete(80)
  391.  
  392. lines = n
  393.  
  394. Redraw
  395.  
  396. /*
  397.  * Group all lines
  398.  */
  399. SelectObject 0
  400. DO n = 1 TO lines
  401.     SelectObject line.n 'MULTIPLE'
  402. END
  403.  
  404. Group
  405. CurrentObject
  406. lines = result
  407.  
  408. /*
  409.  * Group all cells
  410.  */
  411. SelectObject 0
  412. DO j = 1 TO cols
  413.     DO i = 1 TO rows
  414.         IF cell.i.j ~= 0 THEN SelectObject cell.i.j 'MULTIPLE'
  415.     END
  416. END
  417. CALL Complete(90)
  418.  
  419. Group
  420. CurrentObject
  421. cells = result
  422.  
  423. /*
  424.  * Group all object with box
  425.  */
  426. SelectObject line.0
  427. SelectObject cells 'MULTIPLE'
  428.  
  429. IF lines > 0 THEN SelectObject lines 'MULTIPLE'
  430.  
  431. Group
  432. Redraw
  433.  
  434. ADDRESS VALUE oleport
  435. COMPLETE jobID modID 100
  436. SETJOB jobID modID + 1
  437.  
  438. EXIT 0
  439.  
  440.  
  441.  
  442. GetLocale: PROCEDURE EXPOSE locale
  443. ARG strID
  444.  
  445.     strID = 'þ'strID'þ'; PARSE VALUE GETCLIP(locale) WITH (strID)text'Þ'
  446.  
  447. RETURN text
  448.  
  449.  
  450. Complete:
  451.  
  452.     ADDRESS VALUE oleport
  453.     COMPLETE jobID modID ARG(1)
  454.     ADDRESS
  455.  
  456. RETURN
  457.  
  458.  
  459. GUIGads:
  460.  
  461.     g_offx. = 2;    g_offx.1 = 0;            g_offx.3 = 2
  462.     g_offy. = 2;    g_offy.1 = char.h + 1;    g_offy.3 = 3
  463.     g_wid. = 8;                g_wid.1 = 0;            g_wid.3 = 12
  464.     g_hei. = char.h + 4;    g_hei.1 = char.h + 1;    g_hei.3 = char.h + 6
  465.     g_sx = char.w % 2;    g_sy = char.h % 4
  466.     g_onoff. = 0
  467.  
  468.     box.left = box.left + g_sx; box.top = box.top + 2 * g_sy
  469.     box.w = 36 * char.w
  470.  
  471.     n = 1
  472.     nmain = 1
  473.  
  474.     n1.nmain = n
  475.     x = box.left; y = box.top
  476.     n1 = IniGad(3,1,0,'GAP COLS %1' n n + 2'%2%g',colgap * ms.measure,8)
  477.     CALL IniGad(1,0,1,,GetLocale(4))
  478.     y = y + g_hei.3 + 2 * g_sy
  479.     n2 = IniGad(3,1,0,'GAP ROWS %1' n '%2%g',rowgap * ms.measure,8)
  480.     CALL IniGad(1,0,1,,GetLocale(5))
  481.     y = y + g_hei.3 + 2 * g_sy
  482.     CALL IniGad(2,1,0,'MEASURE %1' n + 1 '%2' n1 n2,GetLocale(6))
  483.     CALL IniGad(1,0,1,,ms.type.measure)
  484.     y = y + g_hei.3 + 2 * g_sy
  485.     CALL IniGad(4,1,0,'PREFS BOX%1' n,pref.box,GetLocale(7))
  486.     x = box.left + box.w % 2
  487.     CALL IniGad(4,0,0,'PREFS LINE%1' n,pref.line,GetLocale(8))
  488.     y = y + g_hei.3 + g_sy
  489.     CALL IniGad(4,1,0,'PREFS LINK%1' n,pref.link,GetLocale(9))
  490.     n2.nmain = n - 1
  491.  
  492.     y = y + g_hei.3 + 2 * g_sy
  493.     CALL IniGad(2,1,0,'START',GetLocale(10))
  494.     g_gads = IniGad(2,3,0,'HELP',GetLocale(11))
  495.  
  496.     box.h = y + g_hei.2 + 2 * g_sy - box.top
  497.  
  498.     WINDOW jobID modID (box.w + 2 * g_sx) (box.h + 2 * g_sy) 1 1
  499.     CALL Gadgets(4,1,g_gads)
  500.  
  501. RETURN nmain
  502.  
  503.  
  504. Gadgets:
  505.  
  506.     IF ARG(1) < 4 THEN
  507.         DO i = 2 TO ARG(); n = ARG(i)
  508.             IF ARG(1) ~= 1 THEN CALL DelGad(n,g_type.n)
  509.             IF ARG(1) ~= 3 THEN CALL NewGad(n,g_type.n)
  510.         END
  511.  
  512.     ELSE IF ARG(1) < 7 THEN
  513.         DO n = ARG(2) TO ARG(3)
  514.             IF ARG(1) ~= 4 THEN CALL DelGad(n,g_type.n)
  515.             IF ARG(1) ~= 6 THEN CALL NewGad(n,g_type.n)
  516.         END
  517.  
  518.     ELSE IF ARG(1) = 8 THEN
  519.         DO n = ARG(2) TO ARG(3)
  520.             IF g_onoff.n THEN CALL NewGad(n,g_type.n)
  521.         END
  522.  
  523.     ELSE DO
  524.         DO n = ARG(2) TO ARG(3)
  525.             g_onoff.n = 0
  526.             IF g_type.n ~= 1 THEN CALL RemoveGadget(olewin,GAD.n)
  527.         END
  528.         CALL SetAPen(olewin,0)
  529.         CALL RectFill(olewin,box.left,box.top,box.left + box.w,box.top + box.h)
  530.         CALL RefreshGadgets(olewin)
  531.         END
  532. RETURN
  533.  
  534.  
  535. DelGad:
  536. PARSE ARG n,t
  537.  
  538.     g_onoff.n = 0
  539.  
  540.     IF t ~= 1 THEN CALL RemoveGadget(olewin,GAD.n)
  541.  
  542.     x = g_xpos.n - g_offx.t; y = g_ypos.n - g_offy.t
  543.     CALL SetAPen(olewin,0)
  544.     CALL RectFill(olewin,x,y,x + g_len.n,y + g_hei.t)
  545.  
  546. RETURN
  547.  
  548.  
  549. NewGad:
  550. PARSE ARG n,t
  551.  
  552.     g_onoff.n = 1
  553.  
  554.     IF t = 2 THEN
  555.         CALL AddGadGet(olewin,g_xpos.n,g_ypos.n,GAD.n,g_str.n,g_msg.n)
  556.  
  557.     ELSE IF t = 3 THEN
  558.         CALL AddGadGet(olewin,g_xpos.n,g_ypos.n,GAD.n,g_str.n,g_msg.n,g_len.n - 4,"RIDGEBORDER")
  559.  
  560.     ELSE IF t = 4 THEN
  561.         CALL AddGadGet(olewin,g_xpos.n,g_ypos.n,GAD.n,D2C(32 + g_str.n * 183),g_msg.n)
  562.  
  563.     ELSE DO
  564.         CALL SetAPen(olewin,1)
  565.         CALL Move(olewin,g_xpos.n,g_ypos.n)
  566.         CALL Text(olewin,g_str.n)
  567.         END
  568. RETURN
  569.  
  570.  
  571. IniGad:
  572. PARSE ARG t,na,nx,g_msg.n,g_str.n,var
  573.  
  574.     x = x + nx * g_sx
  575.  
  576.     IF t = 3 & var > 0 THEN
  577.         g_len.n = var * char.w + g_wid.t
  578.     ELSE IF t = 3 THEN
  579.         g_len.n = box.left + box.w - x
  580.     ELSE
  581.         g_len.n = LENGTH(g_str.n) * char.w + g_wid.t
  582.  
  583.     IF na > 0 THEN x = box.left + (na - 1) * (box.w - g_len.n) % 2 + nx * g_sx
  584.  
  585.     g_xpos.n = x + g_offx.t; g_ypos.n = y + g_offy.t; g_type.n = t
  586.     x = x + g_len.n
  587.     n = n + 1
  588.  
  589.     IF t = 4 THEN CALL IniGad(1,0,1,,var)
  590.  
  591. RETURN n - 1
  592.